home *** CD-ROM | disk | FTP | other *** search
/ PCDisk Magazine Disks / PCDisk Magazine - Disk 2.img / PAINTER.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1984-11-10  |  14.6 KB  |  372 lines
  1. 10  'PICTURE PAINTER v1.4d    -Copyright 1984, MBH Software Systems
  2. 15  SCREEN 0
  3. 20  CLEAR ,,2048:KEY OFF:CLS:PSTART%=1
  4. 25  FOR X = 1 TO 10 : KEY X,"": NEXT
  5. 30  WIDTH 80: COLOR 7,0:ESCFLAG=0:LOCATE 24,56:PRINT "Press any key to begin.";
  6. 40  COLOR 12:SCOL = 3:WORDL$="Picture ":WORDR$="Painter":GOSUB 130
  7. 50  IF ESCFLAG=1 THEN 120
  8. 60  COLOR 2:SCOL = 6:WORDL$="Version ":WORDR$=" 1.4d":GOSUB 130
  9. 70  IF ESCFLAG=1 THEN 120
  10. 80  COLOR 6:SCOL = 18:WORDL$="Copyright":WORDR$=" 1984,":GOSUB 130
  11. 90  IF ESCFLAG=1 THEN 120
  12. 100  COLOR 15:SCOL = 20:WORDL$="MBH  Soft":WORDR$="ware Systems":GOSUB 130
  13. 110  CMD$=INKEY$:IF CMD$="" THEN 110  
  14. 120  GOTO 470
  15. 130  'Subroutine for jazzed up screen display.
  16. 140  FOR I=1 TO SCOL-1
  17. 150    CMD$=INKEY$:IF CMD$<>"" THEN ESCFLAG=1:RETURN
  18. 160    LOCATE I,1
  19. 170    PRINT SPACE$(LEN(WORDL$));
  20. 180    LOCATE I,80-LEN(WORDR$)
  21. 190    PRINT SPACE$(LEN(WORDR$));
  22. 200    LOCATE I+1,1
  23. 210    PRINT WORDL$;
  24. 220    LOCATE I+1,80-LEN(WORDR$)
  25. 230    PRINT WORDR$;
  26. 240  NEXT I
  27. 250  LSTOP = (80-(LEN(WORDL$)+LEN(WORDR$)+1))\2
  28. 260  RSTOP = LSTOP + LEN(WORDL$)
  29. 270  IF LSTOP > 80-RSTOP THEN MOVEIT = LSTOP ELSE MOVEIT = 80-RSTOP
  30. 280  FOR I = 1 TO MOVEIT
  31. 290  CMD$=INKEY$:IF CMD$<>"" THEN ESCFLAG=1:RETURN
  32. 300    IF I > LSTOP THEN 330
  33. 310      LOCATE SCOL,I
  34. 320      PRINT WORDL$;
  35. 330   IF 80-(LEN(WORDR$)-1+I) < RSTOP THEN 360
  36. 340     LOCATE SCOL,80-(LEN(WORDR$)-1+I)
  37. 350     PRINT WORDR$;
  38. 360  NEXT I
  39. 370  FOR I = 1 TO MOVEIT
  40. 380  CMD$=INKEY$:IF CMD$<>"" THEN ESCFLAG=1:RETURN
  41. 390   IF I > LSTOP-1 THEN 420
  42. 400     LOCATE SCOL,I
  43. 410     PRINT " ";
  44. 420   IF 80-I < RSTOP+LEN(WORDR$) THEN 450
  45. 430     LOCATE SCOL,(80-I)
  46. 440     PRINT " ";
  47. 450  NEXT I
  48. 460  RETURN
  49. 470  'Ask if help is needed
  50. 480  CLS:COLOR 15:LOCATE 12,20:PRINT "Would you like to see the INSTRUCTION SCREEN"
  51. 490  SROW=12:SCOL=66:MAX=1:GOSUB 3430
  52. 500  IF DAT$="Y" THEN 1250
  53. 510  PSTART%=0
  54. 520  'Begin program here.
  55. 530  BACKCOLOR=8:PALETTE=0:TEXTMODEFLAG=0:ALTKEY$="":BORDERCOL=1
  56. 540  DIM STORARY%(194),BEFPLEFT%(3962),BEFPRIGHT%(3962),SAVEBLOCK%(5):KOPY=0
  57. 550  SCREEN 1,0:COLOR BACKCOLOR,PALETTE,0
  58. 560  CLS:LINE (0,0)-(319,199),BORDERCOL,B
  59. 570  XX=160:YY=100:OLDXX=160:OLDYY=100:LASTXX=0:LASTYY=0:DDRAW=0:CUSCOL=1
  60. 580  '  INITIALIZE BEFPAINT VARIABLE.
  61. 590  GET (1,1)-(159,198),BEFPLEFT% : GET (160,1)-(318,198),BEFPRIGHT%
  62. 600  BEFCOLOR = POINT(XX,YY)
  63. 610  CMD$=INKEY$:IF CMD$="" THEN POKE 23,(PEEK(23) AND 223):GOTO 610
  64. 620  IF MID$(CMD$,2,1) = "K" THEN XX=XX-1:GOTO 1010
  65. 630  IF MID$(CMD$,2,1) = "M" THEN XX=XX+1:GOTO 1010
  66. 640  IF MID$(CMD$,2,1) = "s" THEN XX=XX-5:GOTO 1010
  67. 650  IF MID$(CMD$,2,1) = "t" THEN XX=XX+5:GOTO 1010
  68. 660  IF MID$(CMD$,2,1) = "P" THEN YY=YY+1:GOTO 1010
  69. 670  IF MID$(CMD$,2,1) = "H" THEN YY=YY-1:GOTO 1010
  70. 680  IF MID$(CMD$,2,1) = "u" THEN YY=YY+5:GOTO 1010
  71. 690  IF MID$(CMD$,2,1) = "w" THEN YY=YY-5:GOTO 1010
  72. 700  IF MID$(CMD$,2,1) = "G" THEN YY=YY-1:XX=XX-1:GOTO 1010
  73. 710  IF MID$(CMD$,2,1) = "O" THEN YY=YY+1:XX=XX-1:GOTO 1010
  74. 720  IF MID$(CMD$,2,1) = "I" THEN YY=YY-1:XX=XX+1:GOTO 1010
  75. 730  IF MID$(CMD$,2,1) = "Q" THEN YY=YY+1:XX=XX+1:GOTO 1010
  76. 740  IF TEXTMODEFLAG THEN 3140
  77. 750  '   IF COMMAND ENTERED IS SMALL CASE MAKE IT LARGE.
  78. 760  IF ASC(CMD$)>96 AND ASC(CMD$)<123 THEN CMD$=CHR$(ASC(CMD$)-32)
  79. 770  IF CMD$ = "-" THEN PALETTE=0:COLOR BACKCOLOR,PALETTE
  80. 780  IF CMD$ = "=" THEN PALETTE=1:COLOR BACKCOLOR,PALETTE
  81. 790  IF CMD$ = "0" THEN CUSCOL = 0
  82. 800  IF CMD$ = "1" THEN CUSCOL = 1
  83. 810  IF CMD$ = "2" THEN CUSCOL = 2
  84. 820  IF CMD$ = "3" THEN CUSCOL = 3
  85. 830  IF CMD$ = "M" THEN OLDXX=XX:OLDYY=YY
  86. 840  IF CMD$ = "D" AND DDRAW = 0 THEN DDRAW = 1 : GOSUB 1170
  87. 850  IF ASC(CMD$) = 27 AND DDRAW THEN DDRAW=0 : PUT (0,0),STORARY%,PSET
  88. 860  IF CMD$ = "L" THEN GOSUB 1900
  89. 870  IF CMD$ = "P" THEN GOSUB 2000
  90. 880  IF CMD$ = "B" THEN GOSUB 2110
  91. 890  IF CMD$ = "E" THEN GOSUB 2350
  92. 900  IF CMD$ = "R" THEN GOSUB 2560
  93. 910  IF CMD$ = "C" THEN GOSUB 2260
  94. 920  IF CMD$ = "A" THEN GOSUB 2960
  95. 930  IF CMD$ = "U" THEN PUT (1,1),BEFPLEFT%,PSET : PUT (160,1),BEFPRIGHT%,PSET :     BEFCOLOR = POINT(XX,YY)
  96. 940  IF CMD$ = "T" AND DDRAW = 0 THEN PSET (XX,YY),BEFCOLOR:GET (0,0)-(32,8),        STORARY%
  97. 950  IF CMD$ = "T" THEN LOCATE 1,1:PRINT "Text";:LINE (32,0)-(32,8),BORDERCOL :      LINE (0,8)-(32,8),BORDERCOL : TEXTMODEFLAG=1 : DDRAW=0:GOTO 610
  98. 960  IF CMD$ = "S" THEN KOPY=1:GOSUB 3230
  99. 970  IF CMD$ = "K" AND KOPY THEN GOSUB 3360
  100. 980  IF CMD$ = "X" THEN GOSUB 2060
  101. 990  IF CMD$ = "H" THEN GOSUB 1200
  102. 1000  IF CMD$ = "?" THEN ERASE STORARY%,BEFPLEFT%,BEFPRIGHT%,SAVEBLOCK%:GOTO 520
  103. 1010  'Adjust so pointer does not exceed borders.
  104. 1020  IF XX>318 THEN XX=318
  105. 1030  IF YY>198 THEN YY=198
  106. 1040  IF TEXTMODEFLAG=0 AND DDRAW=0 THEN 1070
  107. 1050  IF XX>=28 AND XX<=32 AND YY<9 THEN XX=33 : GOTO 1070
  108. 1060  IF YY=8 AND XX<33 THEN YY=9
  109. 1070  IF XX<1   THEN XX=1
  110. 1080  IF YY<1   THEN YY=1
  111. 1090  'If in draw mode leave current position as is. If not, restore dot.
  112. 1100  'Save color of this position.
  113. 1110  IF DDRAW THEN 1140
  114. 1120  PRESET(LASTXX,LASTYY),BEFCOLOR
  115. 1130  BEFCOLOR = POINT(XX,YY)
  116. 1140  PSET(XX,YY),CUSCOL
  117. 1150  LASTXX = XX : LASTYY = YY
  118. 1160  GOTO 610
  119. 1170  'Check if draw mode is on or not and display appropriate message.
  120. 1180  IF DDRAW THEN PSET(XX,YY),BEFCOLOR:GET (0,0)-(32,8),STORARY% : LOCATE 1,1 :     PRINT "Draw"; : LINE (32,0)-(32,8),BORDERCOL : LINE (0,8)-(32,8),BORDERCOL
  121. 1190  RETURN
  122. 1200  ' Help menu display routine.
  123. 1210  PSET (XX,YY),BEFCOLOR
  124. 1220  ERASE SAVEBLOCK% : DIM SAVESCREEN%(8002)
  125. 1230  GET (0,0)-(319,199),SAVESCREEN%
  126. 1240  SCREEN 0,0,0 : WIDTH 80
  127. 1250  COLOR 7,1,1
  128. 1260  RESTORE:CLS:LOCATE 1,1,0:FOR I=1 TO 23:READ A$:PRINT A$:NEXT I
  129. 1270  READ A$ : PRINT A$;
  130. 1280  CMD$=INKEY$:IF CMD$="" THEN 1280
  131. 1290  IF ASC(CMD$)=27 AND PSTART%=1 THEN 510
  132. 1300  IF ASC(CMD$)=27 THEN 1360
  133. 1310  IF ASC(CMD$)<>32 THEN 1280
  134. 1320  CLS:LOCATE 1,1,0:FOR I=1 TO 23:READ A$:PRINT A$:NEXT I
  135. 1330  READ A$ : PRINT A$;
  136. 1340  CMD$=INKEY$:IF CMD$="" THEN 1340
  137. 1350  IF PSTART%=1 THEN 510
  138. 1360  CLS:SCREEN 1:COLOR BACKCOLOR,PALETTE
  139. 1370  PUT (0,0),SAVESCREEN%,PSET
  140. 1380  ERASE SAVESCREEN% : DIM SAVEBLOCK%(5) : KOPY = 0
  141. 1390  RETURN
  142. 1400  ' Data statements for help menus
  143. 1410  DATA "                     >>>     INSTRUCTION SCREEN     <<<            Page 1"
  144. 1420  DATA " KEYTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENCLOSE"
  145. 1430  DATA " OPENTo move the pinpoint, on side pad, press:                OPEN"
  146. 1440  DATA " OPEN                                                         OPEN"
  147. 1450  DATA " OPEN  1, 2, 3, 4, 6, 7, 8, or 9. Ctrl-6, Ctrl-4, Ctrl-1,     OPEN"
  148. 1460  DATA " OPEN  or Ctrl-7 moves pinpoint increments of 5.              OPEN"
  149. 1470  DATA " SCREENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENLOAD"
  150. 1480  DATA " KEYTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENCLOSE"
  151. 1490  DATA " OPENColor control:                      OPEN"
  152. 1500  DATA " OPEN                                    OPEN         KEYTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENCLOSE"
  153. 1510  DATA " OPEN  Border:  'B <0, 1, 2, or 3>',     OPEN         OPENCircles:                   OPEN"
  154. 1520  DATA " OPEN  Background:  'BB <0 thru 15> B',  OPEN         OPEN                           OPEN"
  155. 1530  DATA " OPEN  Palettes:  '-' or '=',            OPEN         OPEN  'C <radius> C' - draws  aOPEN"
  156. 1540  DATA " OPEN  Pinpoint:  '1', '2', '3', or '0'. OPEN         OPEN      circle with specifiedOPEN"
  157. 1550  DATA " SCREENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENLOAD         OPEN      radius.              OPEN"
  158. 1560  DATA " KEYTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENCLOSE OPEN  'CC' - draws   a   circleOPEN"
  159. 1570  DATA " OPENLines and Boxes:                            OPEN OPEN      thru last marked  po-OPEN"
  160. 1580  DATA " OPEN                                            OPEN OPEN      sition.              OPEN"
  161. 1590  DATA " OPEN  Use 'M' to set a marked position.         OPEN SCREENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENLOAD"
  162. 1600  DATA " OPEN  'LL' - draws a line from current position OPEN"
  163. 1610  DATA " OPEN         to last marked position.           OPEN   Press 'space bar' for next"
  164. 1620  DATA " OPEN  'LB' - draws a box; corners are current   OPEN   page or <Esc> to exit Help."
  165. 1630  DATA " OPEN         position to last marked postion.   OPEN"
  166. 1640  DATA " SCREENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENLOAD"
  167. 1650  DATA "                     >>>     INSTRUCTION SCREEN     <<<            Page 2"
  168. 1660  DATA ""
  169. 1670  DATA " KEYTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENCLOSE  KEYTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENCLOSE"
  170. 1680  DATA " OPENCopying Blocks:                    OPEN  OPENOther commands:                    OPEN"
  171. 1690  DATA " OPEN                                   OPEN  OPEN                                   OPEN"
  172. 1700  DATA " OPEN  'S' - Saves in memory the box    OPEN  OPEN  'A' - Swaps current position     OPEN"
  173. 1710  DATA " OPEN        formed by the current      OPEN  OPEN        with last marked position. OPEN"
  174. 1720  DATA " OPEN        position and last marked   OPEN  OPEN  'E' - Exits the program. Saves   OPEN"
  175. 1730  DATA " OPEN        position.                  OPEN  OPEN        the graph if desired.      OPEN"
  176. 1740  DATA " OPEN  'K' - Copies the last saved      OPEN  OPEN  'R' - Retrieves a graph saved on OPEN"
  177. 1750  DATA " OPEN        box back onto the screen   OPEN  OPEN        disk. Asks for filename.   OPEN"
  178. 1760  DATA " OPEN        in the new position of the OPEN  OPEN  'P <1, 2, 3 or 0>' - Paints in   OPEN"
  179. 1770  DATA " OPEN        current 'pinpoint'.        OPEN  OPEN        area bordered by specified OPEN"
  180. 1780  DATA " SCREENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENLOAD  OPEN        color.                     OPEN"
  181. 1790  DATA "                                        OPEN  'D' - Puts program in DRAW mode. OPEN"
  182. 1800  DATA " KEYTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENLOAD                     KEYTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENLOAD"
  183. 1810  DATA " OPEN 'T' - Switches program into text mode. Allows any charact- OPEN"
  184. 1820  DATA " OPEN       ers to be placed on screen; use 'ALT <ASC #>' for    OPEN"
  185. 1830  DATA " OPEN       characters not on keyboard.                          OPEN Press any key"
  186. 1840  DATA " OPEN 'U' - Restores graph to what it looked like before last    OPEN   when done."
  187. 1850  DATA " OPEN       'X', 'K' or 'P'.                                     OPEN"
  188. 1860  DATA " OPEN 'X' - Saves entire screen in memory.                       OPEN"
  189. 1870  DATA " OPEN '?' - Clears screen and starts again with blank screen.    OPEN"
  190. 1880  DATA " SCREENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENLOAD"
  191. 1890  '                          LINES OR BOXES TAKEN HERE
  192. 1900  CMD$=INKEY$:IF CMD$="" THEN 1900
  193. 1910  IF CMD$="B" OR CMD$="b" THEN 1950
  194. 1920  IF CMD$<>"L" AND CMD$<>"l" THEN 1980
  195. 1930  LINE (XX,YY)-(OLDXX,OLDYY),CUSCOL
  196. 1940  GOTO 1960
  197. 1950  LINE (XX,YY)-(OLDXX,OLDYY),CUSCOL,B
  198. 1960  PSET (XX,YY),CUSCOL : BEFCOLOR = CUSCOL
  199. 1970  CMD$=""
  200. 1980  RETURN
  201. 1990  '                          PAINTING DONE HERE
  202. 2000  CMD$=INKEY$:IF CMD$="" THEN 2000
  203. 2010  '    SAVE SCREEN BEFORE PAINTING IT.
  204. 2020  GOSUB 2060
  205. 2030  PAINT(XX,YY),CUSCOL,VAL(CMD$)
  206. 2040  BEFCOLOR = CUSCOL '     RETAIN CURRENT POSITIONS COLOR
  207. 2050  RETURN
  208. 2060  '          Option X - save screen.
  209. 2070  PRESET(LASTXX,LASTYY),BEFCOLOR
  210. 2080  GET (1,1)-(159,198),BEFPLEFT% : GET (160,1)-(318,198),BEFPRIGHT%
  211. 2090  PRESET(LASTXX,LASTYY),CUSCOL
  212. 2100  RETURN
  213. 2110  '                          BORDER DRAWER
  214. 2120  CMD$=INKEY$:IF CMD$="" THEN 2120
  215. 2130  IF CMD$<>"B" AND CMD$<>"b" THEN 2220
  216. 2140  '                          BACKGROUND COLOR
  217. 2150  CAT$ = ""
  218. 2160  CMD$=INKEY$:IF CMD$="" THEN 2160
  219. 2170  IF CMD$="B" OR CMD$="b" THEN 2200
  220. 2180  IF CMD$<"0" OR CMD$ >"9" THEN 2250
  221. 2190  CAT$=CAT$+CMD$:GOTO 2160
  222. 2200  BACKCOLOR=VAL(CAT$):COLOR BACKCOLOR,PALETTE
  223. 2210  GOTO 2250
  224. 2220  IF CMD$<>"0" AND CMD$<>"1" AND CMD$<>"2" AND CMD$<>"3" THEN GOTO 2250
  225. 2230  BORDERCOL = VAL(CMD$)
  226. 2240  LINE(0,0)-(319,199),BORDERCOL,B
  227. 2250  RETURN
  228. 2260  '                          CIRCLE DRAWER
  229. 2270  CAT$ = ""
  230. 2280  CMD$=INKEY$:IF CMD$="" THEN 2280
  231. 2290  IF CMD$=>"0" AND CMD$<="9" THEN CAT$=CAT$+CMD$:GOTO 2280
  232. 2300  IF CMD$<>"C" AND CMD$<>"c" THEN 2340
  233. 2310  RAD#=(OLDXX-XX)^2+(OLDYY-YY)^2
  234. 2320  IF CAT$="" THEN CIRCLE (XX,YY),SQR(RAD#),CUSCOL : GOTO 2340
  235. 2330  CIRCLE (XX,YY),VAL(CAT$),CUSCOL
  236. 2340  RETURN
  237. 2350  '                          SAVING/EXITING PROCESS
  238. 2360  GET (64,32)-(255,39),STORARY%
  239. 2370  LOCATE 5,9 : PRINT "Save graph (Y/N)?      :"
  240. 2380  SROW=5:SCOL=27:MAX=1:GOSUB 3430:YNRES$=DAT$
  241. 2390  IF YNRES$="N" THEN GOSUB 2490 ELSE GOSUB 2920
  242. 2400  PRESET(LASTXX,LASTYY),BEFCOLOR
  243. 2410  IF SAVRES$>"A" AND SAVRES$<"Z" THEN GOTO 2460
  244. 2420  IF SAVRES$>"a" AND SAVRES$<"z" THEN GOTO 2460
  245. 2430  LOCATE 5,9 : PRINT "    Graph not saved.    "
  246. 2440  FOR WT = 1 TO 1000 : NEXT WT
  247. 2450  GOTO 2520
  248. 2460  DEF SEG = &HB800
  249. 2470  ON ERROR GOTO 2780:ERRLX%=5:ERRLY%=9
  250. 2480  BSAVE SAVRES$,0,&H4000
  251. 2490  LOCATE 5,9 : PRINT "Resume (Y/N)?          :"
  252. 2500  SROW=5:SCOL=23:MAX=1:GOSUB 3430:YNRES$=DAT$
  253. 2510  IF YNRES$="N" THEN GOTO 3620
  254. 2520  PUT (64,32),STORARY%,PSET
  255. 2530  PRESET(LASTXX,LASTYY),CUSCOL
  256. 2540  RETURN
  257. 2550  '                          RESTORE PROCESS
  258. 2560  PSET (XX,YY),BEFCOLOR
  259. 2570  ERASE SAVEBLOCK% : DIM SAVESCREEN%(8002)
  260. 2580  GET (0,0)-(319,199),SAVESCREEN%
  261. 2590  SCREEN 0,0,0 : WIDTH 80
  262. 2600  COLOR 3,0,0:PRINT "Files on disk are:":PRINT
  263. 2610  ON ERROR GOTO 2780 : ERRLX%=CSRLIN : ERRLY%=1
  264. 2620  FILES:PRINT 
  265. 2630  PRINT "Enter filename to be restored (or just RETURN to cancel):"
  266. 2640  SROW=CSRLIN-1:SCOL=59:MAX=12:GOSUB 3430:SAVRES$=DAT$
  267. 2650  IF NOT(SAVRES$>"A" AND SAVRES$<"Z") THEN 2740
  268. 2660  IF SAVRES$=SPACE$(MAX) THEN 2740
  269. 2670  DEF SEG = &HB800
  270. 2680  ON ERROR GOTO 2780:ERRLX%=5:ERRLY%=9
  271. 2690  CLS:SCREEN 1:COLOR BACKCOLOR,PALETTE
  272. 2700  BLOAD SAVRES$,0
  273. 2710  BEFCOLOR = POINT (XX,YY)
  274. 2720  GET (1,1)-(159,198),BEFPLEFT% : GET (160,1)-(318,198),BEFPRIGHT%
  275. 2730  GOTO 2760
  276. 2740  CLS:SCREEN 1:COLOR BACKCOLOR,PALETTE
  277. 2750  PUT (0,0),SAVESCREEN%,PSET
  278. 2760  ERASE SAVESCREEN%:DIM SAVEBLOCK%(5):KOPY=0
  279. 2770  RETURN
  280. 2780  '              Error trapping routine. (For filenames.)
  281. 2790  LOCATE ERRLX%,ERRLY%
  282. 2800  IF ERR=53 THEN PRINT "  File was not found.   "
  283. 2810  IF ERR=64 THEN PRINT " Bad filename entered.  "
  284. 2815  IF ERR = 70 THEN GOTO 50000
  285. 2820  IF ERR=71 THEN PRINT "     Disk not ready.    "
  286. 2830  IF ERR=54 THEN PRINT " None Graph file error. "
  287. 2840  IF ERR<>53 AND ERR<>64 AND ERR<>61 AND ERR<>70 AND ERR<>71 AND ERR<>54 THEN PRINT "ERROR=";ERR
  288. 2850  FOR WT = 1 TO 1800 : NEXT WT
  289. 2860  IF ERL = 2480 THEN RESUME 2530
  290. 2870  IF ERL = 2620 THEN RESUME 2740
  291. 2880  IF ERL = 2700 THEN RESUME 2750
  292. 2890  GOTO 3620
  293. 2900  '                          RETRIEVE FILENAME
  294. 2910  GET (64,32)-(255,39),STORARY%
  295. 2920  LOCATE 5,9 : PRINT "Filename:              :"
  296. 2930  SROW=5:SCOL=19:MAX=12:GOSUB 3430:SAVRES$=DAT$
  297. 2940  PUT (64,32),STORARY%,PSET
  298. 2950  RETURN
  299. 2960  '          SHOW THE LAST MARKED POSITION <M> TO THE USER FOR A FEW SECONDS.
  300. 2970  OLDCOL = POINT(OLDXX,OLDYY)
  301. 2980  FOR I = 1 TO 4
  302. 2990    PSET (OLDXX,OLDYY),3-OLDCOL
  303. 3000    FOR J = 1 TO 200 : NEXT J
  304. 3010    PSET (OLDXX,OLDYY),OLDCOL
  305. 3020    FOR J = 1 TO 200 : NEXT J
  306. 3030  NEXT I
  307. 3040  PSET (XX,YY),BEFCOLOR
  308. 3050  BEFCOLOR = OLDCOL
  309. 3060  SWAP XX, OLDXX
  310. 3070  SWAP YY, OLDYY
  311. 3080  LASTXX = XX
  312. 3090  LASTYY = YY
  313. 3100  PSET (XX,YY),CUSCOL
  314. 3110  RETURN
  315. 3120  '          TEXT TYPING MODE.
  316. 3130  'Check if escape code was entered.
  317. 3140  IF ASC(CMD$) = 27 THEN PUT (0,0),STORARY%,PSET:TEXTMODEFLAG=0:GOTO 610
  318. 3150  IF XX>310 AND YY>182 THEN 1010 'If bottom left hand corner, skip.
  319. 3160  PRESET (LASTXX,LASTYY),BEFCOLOR ' Restore color
  320. 3170  IF ASC(CMD$) > 31 AND ASC(CMD$) < 127 THEN                                      ALTKEY$="" : LOCATE INT(YY/8+1),INT(XX/8+1):XX=XX+8:PRINT MID$(CMD$,1,1);:      GOTO 3220
  321. 3180  IF ASC(CMD$)<>0 THEN 1010
  322. 3190  IF ASC(MID$(CMD$,2,1))>119 AND ASC(MID$(CMD$,2,1))<129 THEN                     ALTKEY$=ALTKEY$+MID$(STR$(ASC(MID$(CMD$,2,1))-119),2,1)
  323. 3200  IF ASC(MID$(CMD$,2,1))=129 THEN ALTKEY$=ALTKEY$+"0"
  324. 3210  IF LEN(ALTKEY$)=3 AND VAL(ALTKEY$)<255 THEN LOCATE INT(YY/8+1),INT(XX/8+1):     XX=XX+8:PRINT CHR$(VAL(ALTKEY$));:ALTKEY$=""
  325. 3220  BEFCOLOR=POINT(LASTXX,LASTYY) : GOTO 1010 ' KEEP CURRENT PINPOINT COLOR
  326. 3230  '            SAVE BLOCK OPTION DONE HERE.
  327. 3240  PSET (XX,YY),BEFCOLOR
  328. 3250  X1=XX:Y1=YY:X2=OLDXX:Y2=OLDYY
  329. 3260  IF X1>X2 AND Y1>Y2 THEN SWAP X1,X2 : SWAP Y1,Y2
  330. 3270  IF NOT (X1<X2 AND Y1<Y2) THEN 3350
  331. 3280  TOTXX = X2-X1+1 : TOTYY = Y2-Y1+1
  332. 3290  ARRAYSIZE = 4 + INT((TOTXX*2+7)/8)*TOTYY
  333. 3300  ERASE SAVEBLOCK%:DIM SAVEBLOCK%(ARRAYSIZE)
  334. 3310  GET (X1,Y1)-(X2,Y2),SAVEBLOCK%
  335. 3320  PUT (X1,Y1),SAVEBLOCK%,PRESET
  336. 3330  FOR I = 1 TO 1000 : NEXT I
  337. 3340  PUT (X1,Y1),SAVEBLOCK%,PSET
  338. 3350  RETURN
  339. 3360  '         <K> - PLACE SAVED BLOCK ON SCREEN - DONE HERE.
  340. 3370  IF XX+TOTXX > 319 OR YY+TOTYY > 199 THEN 3420 'WILL IT FIT ON SCREEN??????
  341. 3380  PRESET(LASTXX,LASTYY),BEFCOLOR
  342. 3390  GET (1,1)-(159,198),BEFPLEFT% : GET (160,1)-(318,198),BEFPRIGHT%
  343. 3400  PUT (XX,YY),SAVEBLOCK%,PSET
  344. 3410  BEFCOLOR = POINT (XX,YY)
  345. 3420  RETURN
  346. 3430  'Subroutine for user input on a byte by byte basis.
  347. 3440  DAT$=SPACE$(MAX) : OFFSET = 1
  348. 3450  CMD$=INKEY$ : IF CMD$<>"" THEN 3490
  349. 3460  LOCATE SROW,SCOL-1+OFFSET,0:PRINT "-";:FOR WT=1 TO 50:NEXT
  350. 3470  LOCATE SROW,SCOL-1+OFFSET:PRINT MID$(DAT$,OFFSET,1);:FOR WT=1 TO 100:NEXT 
  351. 3480  GOTO 3450
  352. 3490  IF (MID$(CMD$,2,1)="K" OR ASC(CMD$)=8) AND OFFSET=1 THEN BEEP:GOTO 3450
  353. 3500  IF (MID$(CMD$,2,1)="K" OR ASC(CMD$)=8) THEN OFFSET=OFFSET-1:GOTO 3450
  354. 3510  IF MID$(CMD$,2,1)="M" AND OFFSET=MAX THEN BEEP:GOTO 3450
  355. 3520  IF MID$(CMD$,2,1)="M" THEN OFFSET=OFFSET+1:GOTO 3450
  356. 3530  IF CMD$=" " THEN 3570
  357. 3540  IF ASC(CMD$)=13 THEN 3610
  358. 3550  IF NOT(ASC(CMD$)>=46 AND ASC(CMD$)<=122) THEN 3450
  359. 3560  IF ASC(CMD$)>96 AND ASC(CMD$)<123 THEN CMD$=CHR$(ASC(CMD$)-32)
  360. 3570  LOCATE SROW,SCOL-1+OFFSET:PRINT MID$(CMD$,1,1); 
  361. 3580  MID$(DAT$,OFFSET)=MID$(CMD$,1,1)
  362. 3590  OFFSET=OFFSET + 1 : IF OFFSET>MAX THEN OFFSET=MAX
  363. 3600  GOTO 3450
  364. 3610  RETURN
  365. 3620  SCREEN 0 : WIDTH 80 : SYSTEM : END
  366. 50000  RESUME 50002
  367. 50002  PRINT "PC DISK is write protected"
  368. 50010  LOCATE ERRLX% + 1,ERRLY% - 10: PRINT "Copy this file to a work disk"
  369. 50020  LOCATE ERRLX% + 2,ERRLY% - 10: PRINT "and continue."
  370. 50030  FOR DELAY = 1 TO 3000: NEXT DELAY
  371. 50040   GOTO 3620
  372.